Celestin Apprentice 7/Apprentice-Release7.iso/Environments/Open Prolog 1.0.3d33/External Predicates…/Sources/prlxLibraries.p

Text File | 1996-02-12 | 34KB | 1,126 lines

{$D+} { MacsBug symbols on }
{$R-} { No range checking }

UNIT prlxLibraries;

  INTERFACE

    USES types, lowMem, quickdraw, traps,segLoad,gestaltEqu, standardFile,toolUtils,
    textUtils, prlxdefinitions;

    TYPE

      oeAction = (oeDoNothing, oeCloseFile, oeCloseResFile, oeDeleteFile,
                  oeDisposHandle, oeDisposPtr);
      oeRecHdl = ^oeRecPtr;
      oeRecPtr = ^oeRec;
      oeRec = RECORD
                action: oeAction;
                parameter: longint;
                next: oeRecHdl;
              END;

    PROCEDURE addOE(VAR list: oeRecHdl;
                    action: oeAction;
                    parameter: longint);

    FUNCTION removeOE(VAR list: oeRecHdl;
                      action: oeAction;
                      parameter: longint): osErr;

    FUNCTION doOE(VAR list: oeRecHdl): osErr;

    PROCEDURE initOE(VAR list: oeRecHdl);

    FUNCTION terminateOE(VAR list: oeRecHdl): osErr;

    FUNCTION TrapAvailable(tNumber: integer;
                           tType: TrapType): boolean;

    FUNCTION getStringNumber(id, index: integer): longint;

    FUNCTION walkAList(list: termIndex;
                       VAR head, tail: termIndex;
                       plist: prlxptr): boolean;

    FUNCTION textOfAtomicList(termnumber: termindex;
                              plist: prlxPtr): str255;

    FUNCTION openPrologResFile(plist: prlxPtr): integer;

    FUNCTION returnString(termNumber: termIndex;
                          st: str255;
                          plist: prlxPtr): boolean;

    PROCEDURE openPrologDialogFilter(VAR i: integer;
                                     plist: prlxPtr);

    PROCEDURE writestr(st: str255;
                       plist: prlxPtr);

    PROCEDURE writelnstr(st: str255;
                         plist: prlxPtr);

    PROCEDURE errorstr(st: str255;
                       plist: prlxPtr);

    FUNCTION returnValue(termNumber: termIndex;
                         n: longint;
                         plist: prlxPtr): boolean;

    FUNCTION returnStructure(termNumber: termIndex;
                             st: str255;
                             arity: integer;
                             plist: prlxPtr): boolean;

    FUNCTION returnList(termNumber: termIndex;
                        plist: prlxPtr): boolean;

    FUNCTION returnAtom(termNumber: termIndex;
                        st: str255;
                        plist: prlxPtr): boolean;

    FUNCTION returnUnifiedTerms(a, b: termIndex;
                                plist: prlxPtr): boolean;

    FUNCTION subterm(subtermordinate: integer;
                     termNumber: termIndex;
                     plist: prlxPtr): termIndex;

    FUNCTION listItem(listItemOrdinate: integer;
                      termNumber: termIndex;
                      plist: prlxPtr): termIndex;

    FUNCTION newFreeTerm(plist: prlxPtr): termIndex;

    FUNCTION number(termNumber: termIndex;
                    plist: prlxPtr): boolean;

    FUNCTION atom(termNumber: termIndex;
                  plist: prlxPtr): boolean;

    FUNCTION structure(termNumber: termIndex;
                       plist: prlxPtr): boolean;

    FUNCTION list(termNumber: termIndex;
                  plist: prlxPtr): boolean;

    FUNCTION variable(termNumber: termIndex;
                      plist: prlxPtr): boolean;

    FUNCTION value(termNumber: termIndex;
                   plist: prlxPtr): longint;

    FUNCTION arity(termNumber: termIndex;
                   plist: prlxPtr): integer;

    FUNCTION text(termNumber: termIndex;
                  plist: prlxPtr): str255;

    FUNCTION drawAlert(ALRTid: integer;
                       st: str255;
                       plist: prlxPtr): longint;

    FUNCTION centreDialog(DLOGid: integer;
                          plist: prlxPtr): longint;

    PROCEDURE centreSfGetTEXTFile(vertical: integer;
                                  str: str255;
                                  VAR reply: sfReply);

    PROCEDURE centreSfPutFile(vertical: integer;
                              str: str255;
                              origName: str255;
                              dlgHook: procPtr;
                              VAR reply: sfReply);

    FUNCTION getFileName(VAR FileName: str255;
                         VAR FileVolume: longint): boolean;

    FUNCTION predicateNameAndArity(VAR name: str255;
                                   VAR arity: integer;
                                   plist: prlxPtr): boolean;

    PROCEDURE signalError(error: integer;
                          argumentIndex: integer;
                          hostErrorCode: longint;
                          errorMessage: str255;
                          plist: prlxPtr);

    FUNCTION registerIOHandler(handlerCode: osType;
                               handlerPointer: procPtr;
                               plist: prlxPtr): osErr;

    FUNCTION IOObjectRegisterIsFull(plist: prlxPtr): boolean;

    FUNCTION registerIOObject(VAR objectReference: longint;
                              theHandlerKindCode,theObjectType: osType;
                              privateData: longint;
                              isAStream: boolean;
                              plist: prlxPtr): osErr;

    FUNCTION deregisterIOObject(objectReference: longint;
                                theHandlerKindCode: osType;
                                plist: prlxPtr): osErr;

    FUNCTION getIOObjectInfo(theObjectReference: longint;
                             VAR theHandlerKindCode, theObjectType: osType;
                             VAR privateData: longint;
                             VAR isAStream: boolean;
                             plist: prlxPtr): osErr;

    FUNCTION getIOObjectReference(VAR objectReference: longint;
                                  handlerKindCode,theObjectType: osType;
                                  privateData: longint;
                                  plist: prlxPtr): osErr;

    FUNCTION countIOObjects(handlerKindCode,objectTypeCode: osType;plist: prlxPtr): longint;

    FUNCTION findIndexedIOObjectReference(VAR objectReference: longint;
                                  handlerKindCode,objectTypeCode: osType;
                                  index: longint;
                                  plist: prlxPtr): osErr;

  IMPLEMENTATION

    PROCEDURE signalError(error: integer;
                          argumentIndex: integer;
                          hostErrorCode: longint;
                          errorMessage: str255;
                          plist: prlxPtr);

    {if you want to throw an error from an external predicate, use this}
    {error kind is an index to an ISO error type - see prlxDefinitions.p}
    {hostErrorCode is where you can put a mac error code}
{give an argument index of -1 if you don't want it to try to output the goal's name}

      VAR
        i: integer;
        t, r, q: termIndex;
        ignoreBoolean: boolean;
        thePredicateName: str255;
        thePredicateArity: integer;

      BEGIN

        WITH plist^ DO
          BEGIN
          outcome := error; {outcome is normally 'notAnErrorCode' - this puts a
                             real error code there}
          data[1] := newFreeTerm(plist);
          END;
        ignoreBoolean := predicateNameAndArity(thePredicateName,
                                               thePredicateArity, plist);

        q := plist^.data[1];

        IF argumentIndex <> - 1 {-1 is flag to not even try to output the goal's
                                 name}
           THEN
          BEGIN
          ignoreBoolean := returnList(q, plist); {return a list of error
                                                  information}
          r := subterm(1, q, plist);
          ignoreBoolean := returnStructure(r, 'goal', 1, plist); {first, the
            goal - functor & arguments}
          r := subterm(1, r, plist);
          ignoreBoolean := returnStructure(r, thePredicateName,
                                           thePredicateArity, plist);
          FOR i := 1 TO thePredicateArity DO
            ignoreBoolean := returnUnifiedTerms(subterm(i, r, plist), i, plist);{the
            goal's arguments}
          q := subterm(2, q, plist);
          END;

        IF argumentIndex > 0 {if the argument index is 0 or -1, no argument
                              index info returned}
           THEN
          BEGIN
          ignoreBoolean := returnList(q, plist);
          r := subterm(1, q, plist);
          ignoreBoolean := returnStructure(r, 'argument_index', 1, plist);
          r := subterm(1, r, plist);
          ignoreBoolean := returnValue(r, argumentIndex, plist);
          q := subterm(2, q, plist);
          END;

        IF hostErrorCode <> 0 {if the mac error code = 0, no host error info
                               returned}
           THEN
          BEGIN
          ignoreBoolean := returnList(q, plist);
          r := subterm(1, q, plist);
          ignoreBoolean := returnStructure(r, 'host_error_code', 1, plist);
          r := subterm(1, r, plist);
          ignoreBoolean := returnValue(r, hostErrorCode, plist);
          q := subterm(2, q, plist);
          END;

        IF errorMessage <> '' {only return an error message term if it's
                               non-blank}
           THEN
          BEGIN
          ignoreBoolean := returnList(q, plist);
          r := subterm(1, q, plist);
          ignoreBoolean := returnStructure(r, 'error_message', 1, plist);
          r := subterm(1, r, plist);
          ignoreBoolean := returnAtom(r, errorMessage, plist);
          q := subterm(2, q, plist);
          END;

        ignoreBoolean := returnAtom(q, '[]', plist); {terminate the list}
      END;

    PROCEDURE addOE(VAR list: oeRecHdl;
                    action: oeAction;
                    parameter: longint);

      VAR
        temp: oeRecHdl;

      BEGIN
        temp := oeRecHdl(newHandleClear(sizeOf(oeRec)));
        temp^^.next := list;
        list := temp;
        list^^.action := action;
        list^^.parameter := parameter;
      END;

    FUNCTION existsOE(VAR list: oeRecHdl;
                      action: oeAction;
                      VAR parameter: longint): boolean;

      VAR
        temp: oeRecHdl;
        found: boolean;

      BEGIN
        temp := list;
        found := false;
        REPEAT
          IF temp <> NIL THEN
            BEGIN
            IF temp^^.action = action THEN
              found := true
            ELSE
              temp := temp^^.next;
            END;
        UNTIL (temp = NIL) OR found;
        IF found THEN parameter := temp^^.parameter;
        existsOE := found;
      END;

    FUNCTION removeOE(VAR list: oeRecHdl;
                      action: oeAction;
                      parameter: longint): osErr;

      VAR
        temp: oeRecHdl;
        found: boolean;

      BEGIN
        temp := list;
        REPEAT
          IF temp <> NIL THEN
            BEGIN
            found := (temp^^.action = action) AND (temp^^.parameter =
                     parameter);
            IF NOT found THEN temp := temp^^.next;
            END;
        UNTIL (temp = NIL) OR found;
        IF found THEN
          BEGIN
          removeOE := noErr;
          temp^^.action := oeDoNothing;
          END
        ELSE
          removeOE := paramErr;
      END;

    FUNCTION doOE(VAR list: oeRecHdl): osErr;

      TYPE
        fssSpecPtr = ^fsSpec;

      VAR
        temp: oeRecHdl;
        thePort: grafPtr;
        errorCode: osErr;

      BEGIN
        errorCode := noErr;
        WHILE (list <> NIL) AND (errorCode = noErr) DO
          WITH list^^ DO
            BEGIN
            hLock(handle(list));
            CASE action OF
              oeDoNothing: ;
              oeCloseFile: errorCode := fsClose(parameter);
              oeCloseResFile:
                BEGIN
                closeResFile(parameter);
                errorCode := resError;
                END;
              oeDeleteFile: errorCode := fSpDelete(fssSpecPtr(parameter)^);
              oeDisposHandle:
                BEGIN
                disposHandle(handle(parameter));
                errorCode := memError;
                END;
              oeDisposPtr:
                BEGIN
                disposPtr(ptr(parameter));
                errorCode := memError;
                END;
            END;
            IF errorCode = noErr THEN
              BEGIN
              temp := list^^.next;
              disposHandle(handle(list));
              list := temp;
              END;
            END;
      END;

    PROCEDURE initOE(VAR list: oeRecHdl);

      BEGIN
        list := NIL;
      END;

    FUNCTION terminateOE(VAR list: oeRecHdl): osErr;

      VAR
        temp: oeRecHdl;
        result: osErr;

      BEGIN
        result := 0;
        WHILE list <> NIL DO
          BEGIN
          IF list^^.action <> oeDoNothing THEN result := paramErr;
          temp := list;
          list := list^^.next;
          disposHandle(handle(temp));
          END;
        terminateOE := result;
      END;

    PROCEDURE openPrologDialogFilter(VAR i: integer;
                                     plist: prlxPtr);

      VAR
        l: longint;

      BEGIN
        WITH plist^ DO
          BEGIN
          callbackrequest := doMyModalDialog;
          callback(entrypoint);
          l := callbackdata[1];
          i := l;
          END;
      END;

    FUNCTION TrapAvailable(tNumber: integer;
                           tType: TrapType): boolean;

{Check to see if a given trap is implemented.
 The recommended approach to see if a trap is implemented is to see if
 the address of the trap routine is the same as the address of the
 Unimplemented trap.}

      VAR
        gMac: sysEnvRec;
        errCode: osErr;

      BEGIN
        errCode := noErr;
        IF (tType = ToolTrap) THEN
          BEGIN
          errCode := sysEnvirons(1, gMac);
          IF (errCode = noErr) & (gMac.machineType > envMachUnknown) &
             (gMac.machineType < envMacII) THEN
            BEGIN {it's a 512KE, Plus, or SE}
            tNumber := BAND(tNumber, $03FF);
            IF tNumber > $01FF THEN {which means the tool traps}
              tNumber := _Unimplemented; {only go to $01FF}
            END;
          END;
        TrapAvailable := (NGetTrapAddress(tNumber, tType) <>
                         GetTrapAddress(_Unimplemented)) AND (errCode = noErr);
      END; {TrapAvailable}

    FUNCTION getStringNumber(id, index: integer): longint;

      VAR
        s: Str255;
        n: longint;
        i: integer;

      BEGIN
        getIndString(s, id, index);
        i := 1;
        n := 0;
        IF length(s) <> 0 THEN
          WHILE (i <= length(s)) AND (s[i] IN ['0'..'9']) DO
            BEGIN
            n := n * 10 + ord(s[i]) - ord('0');
            i := i + 1;
            END;
        getStringNumber := n;
      END;

    FUNCTION walkAList(list: termIndex;
                       VAR head, tail: termIndex;
                       plist: prlxptr): boolean;

      BEGIN
        IF (text(list, plist) = '.') AND (arity(list, plist) = 2) THEN
          BEGIN
          walkAList := true;
          head := subTerm(1, list, plist);
          tail := subTerm(2, list, plist);
          END
        ELSE
          walkAList := false;
      END;

    FUNCTION openPrologResFile(plist: prlxPtr): integer;

      BEGIN
        WITH plist^ DO
          BEGIN
          callbackrequest := getHomeResFileID;
          callback(entrypoint);
          openPrologResFile := callbackdata[1];
          END;
      END;

    FUNCTION textOfAtomicList(termnumber: termindex;
                              plist: prlxPtr): str255;

      VAR
        st: str255;
        i: integer;
        p, q: ptr;
        v: longint;

      BEGIN
        i := 0;
        p := ptr(longint(@st) + 1);
        q := ptr(longint(@v) + 3);
        WHILE (text(termNumber, plist) = '.') AND (arity(termNumber, plist) =
              2) DO
          BEGIN
          IF i <> 255 THEN
            BEGIN
            v := value(subterm(1, termNumber, plist), plist);
            i := i + 1;
            p^ := q^;
            p := ptr(longint(p) + 1);
            END;
          termNumber := subterm(2, termNumber, plist);
          END;
        p := @st;
        q := ptr(longint(@i) + 1);
        p^ := q^;
        textOfAtomicList := st;
      END;

    FUNCTION returnString(termNumber: termIndex;
                          st: str255;
                          plist: prlxPtr): boolean;

      VAR
        continue: boolean;
        i: integer;
        runningTerm: termIndex;

      BEGIN
        runningTerm := termNumber;
        continue := true;
        IF st <> '' THEN
          FOR i := 1 TO length(st) DO
            BEGIN
            IF continue THEN
              continue := returnStructure(runningTerm, '.', 2, plist);
            IF continue THEN
              continue := returnValue(subterm(1, runningTerm, plist),
                                      ord(st[i]), plist);
            IF continue THEN runningTerm := subterm(2, runningTerm, plist);
            END;
        IF continue THEN continue := returnAtom(runningTerm, '[]', plist);
        returnString := continue;
      END;

    PROCEDURE writestr(st: str255;
                       plist: prlxPtr);

      BEGIN
        WITH plist^ DO
          BEGIN
          callbackrequest := writestring;
          s := st;
          callback(entrypoint);
          END;
      END;

    PROCEDURE writelnstr(st: str255;
                         plist: prlxPtr);

      BEGIN
        WITH plist^ DO
          BEGIN
          callbackrequest := writelnstring;
          s := st;
          callback(entrypoint);
          END;
      END;

    PROCEDURE errorstr(st: str255;
                       plist: prlxPtr);

      BEGIN
        WITH plist^ DO
          BEGIN
          callbackrequest := writeerror;
          s := st;
          callback(entrypoint);
          END;
      END;

    FUNCTION predicateNameAndArity(VAR name: str255;
                                   VAR arity: integer;
                                   plist: prlxPtr): boolean;

      BEGIN
        WITH plist^ DO
          BEGIN
          callbackrequest := getPredicateNameAndArity;
          callback(entrypoint);
          predicateNameAndArity := callbackData[3] = messageOK;
          name := s;
          arity := callbackData[1];
          END;
      END;

    FUNCTION returnUnifiedTerms(a, b: termIndex;
                                plist: prlxPtr): boolean;

      BEGIN
        WITH plist^ DO
          BEGIN
          callbackrequest := unifyTerms;
          callbackData[1] := a;
          callbackData[2] := b;
          callback(entrypoint);
          returnUnifiedTerms := callbackData[3] = messageOK;
          END;
      END;

    FUNCTION returnValue(termNumber: termIndex;
                         n: longint;
                         plist: prlxPtr): boolean;

      BEGIN
        WITH plist^ DO
          BEGIN
          callbackrequest := unifyToInteger;
          callbackData[1] := termNumber;
          callbackData[2] := n;
          callback(entrypoint);
          returnValue := callbackData[3] = messageOK;
          END;
      END;

    FUNCTION returnList(termNumber: termIndex;
                        plist: prlxPtr): boolean;

      BEGIN
        WITH plist^ DO
          BEGIN
          callbackrequest := unifyToFunctor;
          callbackData[1] := termNumber;
          callbackData[3] := 2;
          s := '.';
          callback(entrypoint);
          returnList := callbackData[3] = messageOK;
          END;
      END;

    FUNCTION returnStructure(termNumber: termIndex;
                             st: str255;
                             arity: integer;
                             plist: prlxPtr): boolean;

      BEGIN
        WITH plist^ DO
          BEGIN
          callbackrequest := unifyToFunctor;
          callbackData[1] := termNumber;
          callbackData[3] := arity;
          s := st;
          callback(entrypoint);
          returnStructure := callbackData[3] = messageOK;
          END;
      END;

    FUNCTION returnAtom(termNumber: termIndex;
                        st: str255;
                        plist: prlxPtr): boolean;

      BEGIN
        returnAtom := returnStructure(termNumber, st, 0, plist);
      END;

    FUNCTION subterm(subtermordinate: integer;
                     termNumber: termIndex;
                     plist: prlxPtr): termIndex;

      BEGIN
        WITH plist^ DO
          BEGIN
          callbackrequest := getsubterm;
          callbackData[1] := termNumber;
          callbackData[2] := subtermordinate;
          callback(entrypoint);
          IF callbackData[3] = - 1 THEN
            BEGIN
            errorstr(
'attempt to get index of subterm of a variable or atomic term in subterm - index used is 1'
                     , plist);
            subterm := 1;
            END
          ELSE
            subterm := callbackData[3];
          END;
      END;

    FUNCTION listItem(listItemOrdinate: integer;
                      termNumber: termIndex;
                      plist: prlxPtr): termIndex;

      BEGIN
        WHILE listItemOrdinate > 1 DO
          BEGIN
          WITH plist^ DO
            BEGIN
            callbackrequest := getsubterm;
            callbackData[1] := termNumber;
            callbackData[2] := 2;
            callback(entrypoint);
            IF callbackData[3] = - 1 THEN
              BEGIN
              errorstr(
'attempt to get index of subterm of a variable or atomic term in listItem - index used is 1'
                       , plist);
              termNumber := 1;
              END
            ELSE
              termNumber := callbackData[3];
            END;
          listItemOrdinate := listItemOrdinate - 1;
          END;
        WITH plist^ DO
          BEGIN
          callbackrequest := getsubterm;
          callbackData[1] := termNumber;
          callbackData[2] := 1;
          callback(entrypoint);
          IF callbackData[3] = - 1 THEN
            BEGIN
            errorstr(
'attempt to get index of subterm of a variable or atomic term in listItem - index used is 1'
                     , plist);
            listItem := 1;
            END
          ELSE
            listItem := callbackData[3];
          END;
      END;

    FUNCTION newFreeTerm(plist: prlxPtr): termIndex;

      BEGIN
        WITH plist^ DO
          BEGIN
          callbackrequest := getFreeTerm;
          callback(entrypoint);
          newFreeTerm := callbackData[1];
          END;
      END;

    FUNCTION number(termNumber: termIndex;
                    plist: prlxPtr): boolean;

      BEGIN
        WITH plist^ DO
          BEGIN
          callbackrequest := getterminfo;
          callbackData[1] := termNumber;
          callback(entrypoint);
          number := (callbackData[1] = integertag);
          END;
      END;

    FUNCTION atom(termNumber: termIndex;
                  plist: prlxPtr): boolean;

      BEGIN
        WITH plist^ DO
          BEGIN
          callbackrequest := getterminfo;
          callbackData[1] := termNumber;
          callback(entrypoint);
          atom := (callbackData[1] = atomtag);
          END;
      END;

    FUNCTION structure(termNumber: termIndex;
                       plist: prlxPtr): boolean;

      BEGIN
        WITH plist^ DO
          BEGIN
          callbackrequest := getterminfo;
          callbackData[1] := termNumber;
          callback(entrypoint);
          structure := (callbackData[1] = structuretag);
          END;
      END;

    FUNCTION list(termNumber: termIndex;
                  plist: prlxPtr): boolean;

      BEGIN
        WITH plist^ DO
          BEGIN
          callbackrequest := getterminfo;
          callbackData[1] := termNumber;
          callback(entrypoint);
          list := ((callbackData[1] = structuretag) AND (s = '.') AND
                  (callbackData[3] = 2)) OR ((callbackData[1] = atomtag) AND
                  (s = '[]'));
          END;
      END;

    FUNCTION variable(termNumber: termIndex;
                      plist: prlxPtr): boolean;

      BEGIN
        WITH plist^ DO
          BEGIN
          callbackrequest := getterminfo;
          callbackData[1] := termNumber;
          callback(entrypoint);
          variable := (callbackData[1] = variabletag);
          END;
      END;

    FUNCTION value(termNumber: termIndex;
                   plist: prlxPtr): longint;

      BEGIN
        value := 0;
        WITH plist^ DO
          BEGIN
          callbackrequest := getterminfo;
          callbackData[1] := termNumber;
          callback(entrypoint);
          IF callbackData[1] = integertag THEN
            value := callbackData[2]
          ELSE
            BEGIN
            errorstr('attempt to get value of a non-integer - value used is 0',
                     plist);
            value := 0;
            END;
          END;
      END;

    FUNCTION arity(termNumber: termIndex;
                   plist: prlxPtr): integer;

      BEGIN
        WITH plist^ DO
          BEGIN
          callbackrequest := getterminfo;
          callbackData[1] := termNumber;
          callback(entrypoint);
          CASE callbackData[1] OF
            atomtag, integertag, variabletag: arity := 0;
            structuretag: arity := callbackData[3];
            OTHERWISE errorstr('Funny data from getTermInfo in arity', plist);
          END;
          END;
      END;

    FUNCTION text(termNumber: termIndex;
                  plist: prlxPtr): str255;

      VAR
        st: str255;
        i: integer;

      BEGIN
        WITH plist^ DO
          BEGIN
          callbackrequest := getterminfo;
          callbackData[1] := termNumber;
          callback(entrypoint);
          CASE callbackData[1] OF
            atomtag, structuretag: text := s;
            integertag:
              BEGIN
              numtostring(callbackData[2], st);
              text := st;
              END;
            variabletag:
              BEGIN
              numtostring(callbackData[2], st);
              FOR i := 255 DOWNTO 2 DO st[i] := st[i - 1];
              st[1] := '_';
              text := st;
              END;
            OTHERWISE errorstr('Funny data from getTermInfo in text', plist);
          END;
          END;
      END;

    FUNCTION drawAlert(ALRTid: integer;
                       st: str255;
                       plist: prlxPtr): longint;

      BEGIN
        WITH plist^ DO
          BEGIN
          callbackrequest := drawALRT;
          callbackData[1] := ALRTid;
          s := st;
          callback(entrypoint);
          drawAlert := callbackData[2];
          END;
      END;

    FUNCTION centreDialog(DLOGid: integer;
                          plist: prlxPtr): longint;

      VAR
        item: integer;
        myDialog: dialogPtr;

      BEGIN
        WITH plist^ DO
          BEGIN
  (* ###hack        callbackrequest := drawDLOG;
          callbackData[1] := DLOGid;
           callback(entrypoint);
          centreDialog := callbackData[2]; *)

          myDialog := getNewDialog(DLOGid, NIL, windowPtr(1));
          showWindow(myDialog);
          modalDialog(NIL, item);
          disposDialog(myDialog);
          centreDialog := item;
          END;
      END;

    PROCEDURE centreSfGetTEXTFile(vertical: integer;
                                  str: str255;
                                  VAR reply: sfReply);

      VAR
        myPoint: point;
        dialogHandle: dialogTHndl;
        myPort: grafPtr;
        screenWidth, dialogWidth: integer;
        myTypeList: sfTypeList;

      BEGIN
        myTypeList[0] := 'TEXT';
        getPort(myPort);
        WITH myPort^.portBits.bounds DO screenWidth := right - left;
        dialogHandle := dialogTHndl(getResource('DLOG', getDlgId));
        WITH dialogHandle^^.boundsRect DO
          BEGIN
          dialogWidth := right - left;
          myPoint.h := (screenWidth - dialogWidth) DIV 2;
          myPoint.v := vertical;
          END;
        sfGetFile(myPoint, str, NIL, 1, @myTypeList, NIL, reply);
      END;

    PROCEDURE centreSfPutFile(vertical: integer;
                              str: str255;
                              origName: str255;
                              dlgHook: procPtr;
                              VAR reply: sfReply);

      VAR
        myPoint: point;
        dialogHandle: dialogTHndl;
        myPort: grafPtr;
        screenWidth, dialogWidth: integer;

      BEGIN
        getPort(myPort);
        WITH myPort^.portBits.bounds DO screenWidth := right - left;
        dialogHandle := dialogTHndl(getResource('DLOG', putDlgId));
        WITH dialogHandle^^.boundsRect DO
          BEGIN
          dialogWidth := right - left;
          myPoint.h := (screenWidth - dialogWidth) DIV 2;
          myPoint.v := vertical;
          END;
        sfPutFile(myPoint, str, origName, dlgHook, reply);
      END;

    FUNCTION getFileName(VAR FileName: str255;
                         VAR FileVolume: longint): boolean;

      VAR
        reply: sfReply;

      BEGIN
        centreSfGetTEXTFile(75, '', reply);
        FileName := reply.fName;
        FileVolume := reply.vRefNum;
        getFileName := reply.good;
      END;

    FUNCTION registerIOHandler(handlerCode: osType;
                               handlerPointer: procPtr;
                               plist: prlxPtr): osErr;

      BEGIN
        WITH plist^ DO
          BEGIN
          callbackrequest := registerAnIOHandler;
          callbackData[1] := longint(handlerCode);
          callbackData[2] := longint(handlerPointer);
          callback(entrypoint);
          registerIOHandler := callbackRequest;
          END;
      END;

    FUNCTION IOObjectRegisterIsFull(plist: prlxPtr): boolean;

      BEGIN
        WITH plist^ DO
          BEGIN
          callbackrequest := checkIOObjectRegisterIsFull;
          callback(entrypoint);
          IOObjectRegisterIsFull := callbackData[1] = 1;
          END;
      END;

    FUNCTION registerIOObject(VAR objectReference: longint;
                              theHandlerKindCode,theObjectType: osType;
                              privateData: longint;
                              isAStream: boolean;
                              plist: prlxPtr): osErr;

      BEGIN
        WITH plist^ DO
          BEGIN
          callbackrequest := registerAnIOObject;
          callbackData[1] := longint(theHandlerKindCode);
          callbackData[2] := longint(theObjectType);
          callbackData[3] := privateData;
          IF isAStream THEN
            callbackData[4] := 1
          ELSE
            callbackData[4] := 0;
          callback(entrypoint);
          objectReference := callbackData[1];
          registerIOObject := callbackRequest;
          END;
      END;

    FUNCTION deregisterIOObject(objectReference: longint;
                                theHandlerKindCode: osType;
                                plist: prlxPtr): osErr;

      BEGIN
        WITH plist^ DO
          BEGIN
          callbackrequest := deRegisterAnIOObject;
          callbackData[1] := objectReference;
          callbackData[2] := longint(theHandlerKindCode);
          callback(entrypoint);
          deRegisterIOObject := callbackRequest;
          END;
      END;

    FUNCTION getIOObjectInfo(theObjectReference: longint;
                             VAR theHandlerKindCode, theObjectType: osType;
                             VAR privateData: longint;
                             VAR isAStream: boolean;
                             plist: prlxPtr): osErr;

      BEGIN
        WITH plist^ DO
          BEGIN
          callbackrequest := getAnIOObjectInfo;
          callbackData[1] := theObjectReference;
          callback(entrypoint);
          theHandlerKindCode := osType(callbackData[1]);
          theObjectType := osType(callbackData[2]);
         privateData := callbackData[3];
          isAStream := callbackData[4] = 1;
          getIOObjectInfo := callbackRequest;
          END;
      END;

    FUNCTION getIOObjectReference(VAR objectReference: longint;
                                  handlerKindCode,theObjectType: osType;
                                  privateData: longint;
                                  plist: prlxPtr): osErr;

      BEGIN
        WITH plist^ DO
          BEGIN
          callbackrequest := getAnIOObjectReference;
          callbackData[1] := longint(handlerKindCode);
          callbackData[2] := longint(theObjectType);
          callbackData[3] := privateData;
          callback(entrypoint);
          objectReference := callbackData[1];
          getIOObjectReference := callbackRequest;
          END;
      END;

    FUNCTION countIOObjects(handlerKindCode,objectTypeCode: osType;plist: prlxPtr): longint;

      BEGIN
        WITH plist^ DO
          BEGIN
          callbackrequest := getIOObjectCount;
      callbackData[1]:=longint(handlerKindCode);
      callbackData[2]:=longint(objectTypeCode);
          callback(entrypoint);
          countIOObjects := callbackData[1];
          END;
      END;

    FUNCTION findIndexedIOObjectReference(VAR objectReference: longint;
                                  handlerKindCode,objectTypeCode: osType;
                                  index: longint;
                                  plist: prlxPtr): osErr;

      BEGIN
        WITH plist^ DO
          BEGIN
          callbackrequest := getIndexedIOObjectReference;
          callbackData[1] := longint(handlerKindCode);
          callbackData[2] := longint(objectTypeCode);
          callbackData[3] := index;
          callback(entrypoint);
          objectReference := callbackData[1];
          findIndexedIOObjectReference := callbackRequest;
          END;
      END;

END.